#| echo: false #| warning: false #| message: false

# Load libraries
library(quantmod)
Loading required package: xts
Loading required package: zoo

Attaching package: 'zoo'
The following objects are masked from 'package:base':

    as.Date, as.Date.numeric
Loading required package: TTR
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
library(dplyr)

######################### Warning from 'xts' package ##########################
#                                                                             #
# The dplyr lag() function breaks how base R's lag() function is supposed to  #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
# source() into this session won't work correctly.                            #
#                                                                             #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
# dplyr from breaking base R's lag() function.                                #
#                                                                             #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
#                                                                             #
###############################################################################

Attaching package: 'dplyr'
The following objects are masked from 'package:xts':

    first, last
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
library(plotly)
Loading required package: ggplot2

Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':

    last_plot
The following object is masked from 'package:stats':

    filter
The following object is masked from 'package:graphics':

    layout
# Define current year
current_year <- 2025

# 1. Get Daily Data
df_hist_xts <- getSymbols("^IXIC", 
                          from = "2008-01-01", 
                          to = "2025-12-31",
                          src = "yahoo", 
                          auto.assign = FALSE)

# --- STEP A: Calculate the "True" Start Price for each Year ---
# We need the close of the FIRST trading day to calculate accurate YTD
year_start_endpoints <- endpoints(df_hist_xts, on = "years")
# The 'endpoints' function returns the LAST index of the period. 
# To get the FIRST index of the year, we take the previous year's end + 1.
# (We handle the first year manually or just use a grouping trick)

df_daily <- data.frame(Date = index(df_hist_xts), coredata(df_hist_xts)) %>%
  mutate(Year = as.numeric(format(Date, "%Y")))

# Group by Year and take the first available Close price
df_start_prices <- df_daily %>%
  group_by(Year) %>%
  summarise(Start_Price = first(`IXIC.Adjusted`))

# --- STEP B: Natural Weeks (1 to 52) ---
weekly_idx <- endpoints(df_hist_xts, on = "weeks")
df_weekly <- df_hist_xts[weekly_idx, ]
df_weekly <- data.frame(Date = index(df_weekly), coredata(df_weekly)) %>%
  mutate(
    Year = as.numeric(format(Date, "%Y")),
    Week = as.numeric(format(Date, "%V")) # ISO Week
  ) %>%
  # Filter for standard weeks only. 
  # We exclude "Week 53" here because we will manually create the perfect one later.
  # We also exclude the "Week 1" glitch where Dec 31 is labeled as Week 1.
  filter(Week <= 52, !(format(Date, "%m") == "12" & Week == 1))

# --- STEP C: The "Special" Week 53 (Year End) ---
yearly_idx <- endpoints(df_hist_xts, on = "years")
df_yearend <- df_hist_xts[yearly_idx, ]
df_yearend <- data.frame(Date = index(df_yearend), coredata(df_yearend)) %>%
  mutate(
    Year = as.numeric(format(Date, "%Y")),
    Week = 53 # Hard-code this as the final bucket
  )

# --- STEP D: Combine and Calculate ---
# Combine the natural weeks with the special year-end week
df_combined <- bind_rows(df_weekly, df_yearend) %>%
  arrange(Year, Week)

# Join with the Start Prices and calculate % Change
df_plot <- left_join(df_combined, df_start_prices, by = "Year") %>%
  mutate(
    change_from_year_start = ((`IXIC.Adjusted` / Start_Price) - 1) * 100
  )

# Split into historical and current
df_hist_plain <- df_plot %>% filter(Year < current_year)
df_curr_year  <- df_plot %>% filter(Year == current_year)

# Calculate Average
df_avg <- df_hist_plain %>%
  group_by(Week) %>%
  summarise(avg_change = mean(change_from_year_start, na.rm = TRUE))

# --- STEP E: Plotting ---
p <- plot_ly()

# Historical Years
p <- add_trace(p, 
               data = df_hist_plain,
               x = ~Week, 
               y = ~change_from_year_start,
               type = 'scatter', 
               mode = 'lines', 
               split = ~Year, 
               line = list(color = 'grey', width = 1),
               opacity = 0.3,
               hoverinfo = "text",
               text = ~paste("Year:", Year, "<br>Week:", Week, "<br>Change:", round(change_from_year_start, 1),"%"),
               showlegend = FALSE)

# Current Year
if(nrow(df_curr_year) > 0) {
  p <- add_trace(p, 
                 data = df_curr_year,
                 x = ~Week, 
                 y = ~change_from_year_start,
                 type = 'scatter', 
                 mode = 'lines',
                 line = list(color = '#336699', width = 3),
                 name = as.character(current_year),
                 hoverinfo = "text",
                 text = ~paste("Year:", Year, "<br>Week:", Week, "<br>Change:", round(change_from_year_start, 1),"%"))
}

# Average Line
p <- add_trace(p, 
               data = df_avg,
               x = ~Week, 
               y = ~avg_change,
               type = 'scatter', 
               mode = 'lines',
               line = list(color = 'darkred', width = 2, dash = 'dot'),
               name = "Avg Return",
               hoverinfo = "text",
               text = ~paste("Average", "<br>Week:", Week, "<br>Change:", round(avg_change, 1),"%"))

# Layout
p <- p %>% layout(
  xaxis = list(
    title = "Week (53 = Year End)",
    range = c(0.5, 53.5),
    showgrid = FALSE,
    tickvals = c(1, 10, 20, 30, 40, 50, 53),
    ticktext = c("1", "10", "20", "30", "40", "50", "End")
  ),
  yaxis = list(title = "% Change", showgrid = TRUE, gridcolor = "#e5e5e5"),
  showlegend = TRUE,
  legend = list(orientation = "h", y = 1.1),
  plot_bgcolor = "white"
) %>% config(displayModeBar = FALSE)

p